home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / rcmplb30.zip / RCMPDEMS.PRG < prev    next >
Text File  |  1994-02-20  |  16KB  |  517 lines
  1. *--------------------------------------------------------------------------
  2. *                         CLIPPER SUMMER '87 VERSION
  3. *--------------------------------------------------------------------------
  4. * RCmpDemS.PRG - Program to demonstrate the use of the functions
  5. *                in the Clipper Library, RCmpLib v3.0
  6. *
  7. * Used functions :
  8. *
  9. *      R_CmpFile ()  - Compress one or more files into one archive
  10. *      R_DCmpFile () - Extract  one or more files from an archive
  11. *      R_CmpList ()  - Retrieves info about files in a RCmpLib archive
  12. *      R_FSize ()    - Determine the size of a file
  13. *      R_CmpStr ()   - Compress a string
  14. *      R_DCmpStr ()  - Decompress a string
  15. *
  16. * Compile    :  CLIPPER RCMPDEMS
  17. *
  18. * Link       :  PLINK86  file RCMPDEMS lib RCMPLIBS   - or -
  19. *               BLINKER  file RCMPDEMS lib RCMPLIBS
  20. *
  21. * Syntax     :  RCMPDEMS
  22. *--------------------------------------------------------------------------
  23. * Date       :  20/02/94
  24. *--------------------------------------------------------------------------
  25. * Author     :  Rolf van Gelder
  26. *               Binnenwiertzstraat 27
  27. *               5615 HG  EINDHOVEN
  28. *               THE NETHERLANDS
  29. *
  30. * E-Mail     :  Internet   : RCROLF@urc.tue.nl
  31. *               BitNet     : RCROLF@heitue5
  32. *               CompuServe : >INTERNET:rcrolf@urc.tue.nl
  33. *--------------------------------------------------------------------------
  34. * (c) 1994  Rolf van Gelder, All rights reserved
  35. *--------------------------------------------------------------------------
  36.  
  37. PRIVATE aMenu [5]                       && Main menu
  38.  
  39. *-- Initialize menu-array
  40. aMenu [1] = 'Compress files into an archive      - R_CmpFile()'
  41. aMenu [2] = 'Show file-info from an archive file - R_CmpList()'
  42. aMenu [3] = 'Extract files from an archive       - R_DCmpFile()'
  43. aMenu [4] = 'String compression/decompression    - R_CmpStr(),R_DCmpStr()'
  44. aMenu [5] = 'End of Demo'
  45.  
  46. PRIVATE nChoice                         && Menu choice
  47. nChoice = 1
  48.  
  49. PRIVATE nRetCode                        && Return code
  50. PRIVATE cOldCol                         && Old color
  51. PRIVATE aCmpList                        && Array with file-info
  52. PRIVATE nTotOrgSize                     && Counter
  53. PRIVATE nTotCmpSize                     && Counter
  54. PRIVATE nFile                           && Counter
  55. PRIVATE nFiles                          && Counter
  56. PRIVATE nHandle                         && File handle
  57. PRIVATE cString                         && String buffer
  58. PRIVATE nOrgSize                        && Original string size
  59. PRIVATE nCmpSize                        && Compressed string size
  60. PRIVATE aErrTxt [11]                    && Array with error messages
  61.  
  62. *-- Initialize array with error messages
  63. aErrTxt [ 1] = "Invalid parameter passed"
  64. aErrTxt [ 2] = "Error opening input file"
  65. aErrTxt [ 3] = "Not compressed by RCmpLib or protected"
  66. aErrTxt [ 4] = "Wrong version of RCmpLib"
  67. aErrTxt [ 5] = "Error creating output file"
  68. aErrTxt [ 6] = "Error reading input file"
  69. aErrTxt [ 7] = "Error writing output file"
  70. aErrTxt [ 8] = "No files found to compress"
  71. aErrTxt [ 9] = "Function aborted by user"
  72. aErrTxt [10] = "String couldn't be compressed"
  73. aErrTxt [11] = "String was already compressed"
  74.  
  75. SetColor ( 'W+/B' )
  76.  
  77. *-- Disable scoreboard
  78. SET SCOREBOARD OFF
  79.  
  80. *--------------------------------------------------------------------------
  81. *                   M A I N   P R O G R A M   L O O P
  82. *--------------------------------------------------------------------------
  83. DO WHILE .t.
  84.  
  85.    *-- Display header lines
  86.    bHeader ()
  87.  
  88.    *-- Do some advertisement ...
  89.    @ 2,21 SAY 'THE COMPRESSION LIBRARY FOR CA-CLIPPER'
  90.    @ 4,11 SAY ' ▄▄▄▄▄▄▄  ▄▄▄▄▄▄▄                    ▄        ▄▄  ▄      '
  91.    @ 5,11 SAY '▒▒▒▒▒▒▒█ ▒▒▒▒▒▒▒▀                   ▒█       ▒▒▀ ▒█      '
  92.    @ 6,11 SAY '▒█▄▄▄▄▒█ ▒█        ▄▄▄▄▄▄▄  ▄▄▄▄▄▄▄ ▒█        ▄▄ ▒█▄▄▄▄▄▄'
  93.    @ 7,11 SAY '▒▒▒▒▒▒▒▀ ▒█       ▒▒▒▒▒▒▒█ ▒▒▒▒▒▒▒█ ▒█       ▒▒█ ▒▒▒▒▒▒▒█'
  94.    @ 8,11 SAY '▒█   ▒▀▄ ▒█▄▄▄▄▄▄ ▒▒█▒█▒▒█ ▒█▄▄▄▄▒█ ▒█▄▄▄▄▄▄ ▒▒█ ▒█▄▄▄▄▒█'
  95.    @ 9,11 SAY '▒▀    ▒▀ ▒▒▒▒▒▒▒▀ ▒▒▀▒▀▒▒▀ ▒▒▒▒▒▒▒▀ ▒▒▒▒▒▒▒▀ ▒▒▀ ▒▒▒▒▒▒▒▀'
  96.    @10,11 SAY '                           ▒█                            '
  97.    @11,11 SAY ' (c) 1994 Rolf van Gelder  ▒▀ Eindhoven, The Netherlands '
  98.  
  99.    *-- Draw double box for main menu
  100.    @13,8 TO 19,71 DOUBLE
  101.  
  102.    *-- Display main menu
  103.    nChoice = AChoice ( 14, 10, 18, 69, aMenu, '', '', nChoice )
  104.  
  105.    IF LastKey () = 27 .or. nChoice = Len ( aMenu )
  106.       *-- <Esc> or 'End of Demo'
  107.       EXIT
  108.    ENDIF
  109.  
  110.    *-- Display header lines
  111.    bHeader ()
  112.  
  113.    DO CASE
  114.    CASE nChoice = 1
  115.       *-- COMPRESS FILES INTO AN ARCHIVE
  116.  
  117.       CenterMsg ( 3, 'COMPRESS FILES INTO AN ARCHIVE - R_CmpFile()' )
  118.  
  119.       cOldCol = SetColor ( 'W+/BG' )
  120.       @5,13 TO 8,64
  121.       @6,14 SAY ' The files RCMPLIB.*, *.PRG and DUTCH.REG will be '
  122.       @7,14 SAY ' compressed into an archive called ARCHIVE.RCP.   '
  123.       SetColor ( cOldCol )
  124.  
  125.       *-- Hit any key ....
  126.       bHitKey ()
  127.  
  128.       @5,0 CLEAR
  129.  
  130.       *-- Draw box for progression bar
  131.       cOldCol = SetColor ( 'W+/R' )
  132.       @6,23 CLEAR TO 8,56
  133.       @6,23 TO 8,56
  134.       SetColor ( cOldCol )
  135.       @9,25 SAY 'Compressing: '
  136.  
  137.       *--------------------------------------------------------------------
  138.       * Files to compress : RCmpLib.*, *.PRG and Dutch.REG
  139.       * Archive file      : Archive.RCP
  140.       * Keep originals    : lMove = .F.
  141.       * Progression bar   : Length = 30,           (Row,Col) = (7,25)
  142.       *                   : Character = Chr (177), Color = Yellow on Red
  143.       * Password          : none ( '' )
  144.       * Interruptable     : lEscape = .T.
  145.       * User function     : DispName() to display current filename
  146.       *--------------------------------------------------------------------
  147.       nRetCode = R_CmpFile ( 'RCmpLib.*;*.PRG;Dutch.REG', ;
  148.          'Archive.RCP', .F., 30, 7, 25, Chr ( 177 ), 'GR+/R', '', .T., ;
  149.          'DispName' )
  150.  
  151.       *-- Clear box
  152.       @6,0 CLEAR
  153.  
  154.       IF nRetCode != 0
  155.          *-- Error detected : display error message
  156.          CenterMsg ( 22, 'Error : ' + aErrTxt [ nRetCode ] )
  157.  
  158.       ELSE
  159.          *-- No errors detected !
  160.          CenterMsg ( 22, 'Archive ARCHIVE.RCP created.' )
  161.  
  162.       ENDIF
  163.  
  164.       *-- Hit any key ....
  165.       bHitKey ()
  166.  
  167.  
  168.    CASE nChoice = 2
  169.       *-- SHOW FILE-INFO FROM AN ARCHIVE FILE
  170.  
  171.       CenterMsg ( 3, 'SHOW FILE-INFO FROM AN ARCHIVE FILE - R_CmpList()' )
  172.  
  173.       cOldCol = SetColor ( 'W+/BG' )
  174.       @5,17 TO 8,60
  175.       @6,18 SAY ' File information for the files in the    '
  176.       @7,18 SAY ' archive file ARCHIVE.RCP will be listed. '
  177.       SetColor ( cOldCol )
  178.  
  179.       *-- Hit any key ....
  180.       bHitKey ()
  181.  
  182.       @5,0 CLEAR
  183.  
  184.       @5,0 SAY ''
  185.       *-- Determine number of files in the archive
  186.       nFiles = R_CmpList ( 'Archive.RCP' )
  187.  
  188.       IF nFiles > 0
  189.          *-- One of more files found in the archive !
  190.  
  191.          DECLARE aNames   [ nFiles ]    && Filenames
  192.          DECLARE aOSize   [ nFiles ]    && Original file size
  193.          DECLARE aODate   [ nFiles ]    && Original file date
  194.          DECLARE aOTime   [ nFiles ]    && Original file time
  195.          DECLARE aCSize   [ nFiles ]    && Size of compressed file
  196.          DECLARE aRatio   [ nFiles ]    && Compression ratio
  197.          DECLARE aVersion [ nFiles ]    && Version of RCmpLib
  198.  
  199.          nRetCode = R_CmpList ( 'Archive.RCP', '', @aNames, @aOSize, ;
  200.             @aODate, @aOTime, @aCSize, @aRatio, @aVersion )
  201.  
  202.          IF nRetCode >= 0
  203.             *-- File-Info loaded into the arrays !
  204.  
  205.             nTotOrgSize = 0             && Total counters
  206.             nTotCmpSize = 0
  207.  
  208.             CenterMsg ( 5, 'Filename      Org.Size Filedate   Time  ' + ;
  209.               'Cmp.Size    Ratio  Version        ', 'W+/BG' )
  210.  
  211.             *-- Display contents of the file-info array
  212.             FOR nFile = 1 TO nFiles
  213.                ?Str ( nFile, 2 ) + ' ' + ;
  214.                Left ( aNames [ nFile ], 13 ) + ' ' + ;
  215.                Str ( aOSize [ nFile ], 8 ) + ' ' + ;
  216.                aODate [ nFile ] + ' ' + aOTime [ nFile ] + ' ' + ;
  217.